home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1996 #5
/
Amiga Plus CD - 1996 - No. 5.iso
/
pd
/
packer
/
decruncherface
/
source
/
dface.asc
next >
Wrap
Text File
|
1996-06-10
|
11KB
|
462 lines
Set Buffer 8
Global ER,PA1$,PA2$
Dim A$(5)
Dim PTYP$(8)
Dim PTP$(8)
LF$=Chr$(10)
For I=1 To 7 : Read PDATA$ : PTYP$(I)=PDATA$ : Next
Data "LHA","LZX","UNZIP","DMS","UNARJ","PPACK","UNRAR"
CHESTA=1
'----------------------------------------------------
'Tooltypes auslesen
'
WBY=Ex Wb Height
WBX=Ex Wb Width
TTYPE1$=Ex Get Tooltype("DFACE","XPOS")
TTYPE2$=Ex Get Tooltype("DFACE","YPOS")
TTYPE3$=Ex Get Tooltype("DFACE","ICONIFY")
WINX=Val(TTYPE1$)
WINY=Val(TTYPE2$)
If WINX<0 Then WINX=0
If WINY<0 Then WINY=0
If(WINX+250)>WBX Then WINX=(WBX-250)
If(WINY+120)>WBY Then WINY=(WBY-120)
Ex Tooltype Done
'----------------------------------------------------
'Prefs laden
'
If Exist("config")
Open In 1,"config"
Line Input #1,PA1$
Line Input #1,PA2$
Input #1,PREFPACK
Input #1,CHESTA
For I=1 To 7 : Line Input #1,PTYP$(I) : Next I
Close 1
End If
'----------------------------------------------------
Ex Wind Open 1,WINX,WINY,250,120,$20+$40+$200,14,0
Ex Wind Title 1,"DeCruncherFace V1.05"
Ex Gadgets Init 0,1,6
For I=1 To 2
Ex Labels Init I,"LHA,LZH,LZX,ZIP,DMS,ARJ,PP,RUN,RAR,AUTO"
Next
Ex Def Cycle 1,30,30,80,15,Ex Labels(1),"Packer",4,1
Ex Def Button 2,30,60,80,15,"DePack",16,1
Ex Def Button 3,130,30,80,15,"Prefs",16,1
Ex Def Button 4,130,60,80,15,"About",16,1
Ex Def Button 5,130,90,80,15,"Quit",16,1
Ex Def Button 6,30,90,80,15,"Test",16,1
Ex Gadgets Open 1
Ex Set Cycle 1,PREFPACK,1
CP=PREFPACK
If TTYPE3$="YES"
Ex Wind Zip 1
End If
Ex Wind Active 1
SCHLEIFE:
For I=1 To 6
Ex Gadget Unlock I,1
Next
If CP=6 Then Ex Gadget Lock 6,1
TM=0
Do
Multi Wait
MSG=Ex Get Msg(1)
If MSG
Ex Reply Msg
If MSG=$200
GG=Ex Get Key
Ex Wind Zip 1
End If
If MSG=$20
GG=Ex Get Key
End If
If MSG=$40
GG=Ex Get Key
If GG=1
CP=Ex Get Part
If CP=6
Ex Gadget Lock 6,1
End If
If CP<>6
Ex Gadget Unlock 6,1
End If
End If
End If
If GG=5
FERTIG
End If
If GG=2
Exit
End If
If GG=4
Goto ABOUT
End If
If GG=3
Goto PREFS
End If
If GG=6
TM=1 : Exit
End If
End If
Loop
ZEIGER:
P=CP+1
For I=1 To 6
Ex Gadget Lock I,1
Next
On P Goto LHA,LHA,LHA,ZIP,DMS,ARJ,PP,APLUS,ARJ,AUTO
'-----------------------------------------------
LHA:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO1:
If P=2 or P=1
HOLD$=PTYP$(1)
End If
If P=3
HOLD$=PTYP$(2)
End If
If TM=0
If CHESTA=1
PATH[PA2$]
F2$=Param$
Else
F2$=PA2$
End If
If F2$=""
Goto SCHLEIFE
End If
G$=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)+Chr$(0)
End If
If TM=1
G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)+Chr$(0)
End If
DEPACK
Goto SCHLEIFE
'---------------------------------------------------
ZIP:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO3:
If TM=0
If CHESTA=1
PATH[PA2$]
F2$=Param$
Else
F2$=PA2$
End If
If F2$=""
Goto SCHLEIFE
End If
G$=Chr$(34)+PTYP$(3)+Chr$(34)+" "+Chr$(34)+F1$+Chr$(34)+" -x -d "+Chr$(34)+F2$+Chr$(34)
End If
If TM=1
G$=Chr$(34)+PTYP$(3)+Chr$(34)+" -t "+Chr$(34)+F1$+Chr$(34)
End If
DEPACK
Goto SCHLEIFE
'------------------------------------------------
DMS:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO4:
If TM=0
G$=Chr$(34)+PTYP$(4)+Chr$(34)+" write "+Chr$(34)+F1$+Chr$(34)
End If
If TM=1
G$=Chr$(34)+PTYP$(4)+Chr$(34)+" view "+Chr$(34)+F1$+Chr$(34)
End If
DEPACK
Goto SCHLEIFE
'------------------------------------------------
ARJ:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO5:
If P=6
HOLD$=PTYP$(5)
End If
If P=9
HOLD$=PTYP$(7)
End If
If TM=0
If CHESTA=1
PATH[PA2$]
F2$=Param$
Else
F2$=PA2$
End If
If F2$=""
Goto SCHLEIFE
End If
A$(1)="cd "+Chr$(34)+F2$+Chr$(34)
A$(2)=Chr$(34)+HOLD$+Chr$(34)+" x "+Chr$(34)+F1$+Chr$(34)
Open Out 1,"ram:script"
For I=1 To 2
Print #1,A$(I); : Print #1,Chr$(10);
Next I
Close 1
Open Out 1,"ram:puffer"
Print #1,"execute ram:script"; : Print #1,Chr$(10);
Print #1,"wait 3 secs"; : Print #1,Chr$(10);
Print #1,"endshell"; : Print #1,Chr$(10);
Close 1
Exec "newshell con:0/0/640/256/Packer-Ausgabe/close from ram:puffer"
End If
If TM=1
G$=Chr$(34)+HOLD$+Chr$(34)+" t "+Chr$(34)+F1$+Chr$(34)
DEPACK
End If
Goto SCHLEIFE
'--------------------------------------------------
PP:
If TM=1 Then TM=0 : Goto SCHLEIFE
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
If CHESTA=1
PATH[PA2$]
F2$=Param$
Else
F2$=PA2$
End If
If F2$=""
Goto SCHLEIFE
End If
G$=Chr$(34)+PTYP$(6)+Chr$(34)+" nodel "+Chr$(34)+F1$+Chr$(34)+" to "+Chr$(34)+F2$+Chr$(34)
DEPACK
Goto SCHLEIFE
'----------------------------------------------------
APLUS:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
AUTO6:
If TM=0
If CHESTA=1
PATH[PA2$]
F2$=Param$
Else
F2$=PA2$
End If
If F2$=""
Goto SCHLEIFE
End If
G$=Chr$(34)+F1$+Chr$(34)+" "+Chr$(34)+F2$+Chr$(34)
End If
If TM=1
G$=Chr$(34)+F1$+Chr$(34)+" -t"
End If
DEPACK
Goto SCHLEIFE
'-----------------------------------------------------
AUTO:
FISEL
F1$=Param$
If F1$="" Then Goto SCHLEIFE
CHECK$=Lower$(Right$((F1$),4))
If CHECK$=".lha" Then P=1 : Goto AUTO1
If CHECK$=".lzh" Then P=2 : Goto AUTO1
If CHECK$=".lzx" Then P=3 : Goto AUTO1
If CHECK$=".zip" Then Goto AUTO3
If CHECK$=".dms" Then Goto AUTO4
If CHECK$=".arj" Then P=6 : Goto AUTO5
If CHECK$=".run" Then Goto AUTO6
If CHECK$=".rar" Then P=9 : Goto AUTO5
Goto SCHLEIFE
'-----------------------------------------------------
ABOUT:
For I=1 To 6
Ex Gadget Lock I,1
Next
REQ$=""
REQ$=REQ$+" DFace is Freeware, but don't spread it manipulated ! "+LF$
REQ$=REQ$+"Please spread only the original LHA-File with complete"+LF$
REQ$=REQ$+"contents ! I don't give any guaranty, that DFace works"+LF$
REQ$=REQ$+" without errors ! Use DFace at your own risk because "+LF$
REQ$=REQ$+" I'm not responsible for any crashes of your system "+LF$+LF$
REQ$=REQ$+" DFace was designed with Amos_Pro V2.0 and AMIPS "+LF$
REQ$=REQ$+" Written in 6/96 by Andreas Wenk Klingelholl 99 "+LF$
REQ$=REQ$+" 42281 Wuppertal - Germany "+LF$+LF$
REQ$=REQ$+" E-Mail: sks@wizard.art-line.de/sks@legoland.aworld.de"+LF$
REQ$=REQ$+" sks@blue-box.dssd.sub.org ... Please contact me, if "+LF$
REQ$=REQ$+" you have wishes and criticism ! "
RQ=Ex Request(2,"About DFace...",REQ$,"Shut up")
Goto SCHLEIFE
'----------------------------------------------------
PREFS:
For I=1 To 6
Ex Gadget Lock I,1
Next
Ex Wind Open 2,100,30,250,150,$40+$200,14,0
Ex Wind Title 2,"Prefs Window"
Ex Gadgets Init 0,2,8
Ex Def Button 1,10,30,105,15,"Archive-Path",16,2
Ex Def Button 2,125,30,100,15,"Output-Path",16,2
Ex Def Button 3,30,120,50,15,"Save",16,2
Ex Def Button 4,90,120,50,15,"Use",16,2
Ex Def Button 5,150,120,50,15,"Abort",16,2
Ex Def Cycle 6,30,70,70,15,Ex Labels(2),"Packer",4,2
Ex Def Button 7,125,70,100,15,"Packer-Path",16,2
Ex Def Checkbox 8,170,100,0,0,"Destination Request",0,2
Ex Gadgets Open 2
Ex Set Checkbox 8,CHESTA,2
Ex Set Cycle 6,CP,2
MERK=CP
PU1$=PA1$ : PU2$=PA2$
For I=1 To 7 : PTP$(I)=PTYP$(I) : Next I
PCHESTA=CHESTA
SCHLEIFE2:
Ex Wind Active 2
Do
Multi Wait
MSG=Ex Get Msg(2)
If MSG
Ex Reply Msg
If MSG=$200
PA1$=PU1$ : PA2$=PU2$
CP=MERK
Goto PREFSEND
End If
If MSG=$40
GH=Ex Get Key
End If
If GH=5
PA1$=PU1$ : PA2$=PU2$
For I=1 To 7 : PTYP$(I)=PTP$(I) : Next I
CP=MERK
CHESTA=PCHESTA
Goto PREFSEND
End If
If GH=1
PATH[PA1$]
PA1$=Param$
If PA1$=""
PA1$=PU1$
End If
End If
If GH=2
PATH[PA2$]
PA2$=Param$
If PA2$=""
PA2$=PU2$
End If
End If
If GH=3
Open Out 1,"Config"
Print #1,PA1$
Print #1,PA2$
Print #1,PB
Print #1,Ex Get Checkbox(8,2)
For I=1 To 7 : Print #1,PTYP$(I) : Next I
Close 1
Ex Set Cycle 1,CP,1
CHESTA=Ex Get Checkbox(8,2)
Goto PREFSEND
End If
If GH=4
Ex Set Cycle 1,CP,1
CHESTA=Ex Get Checkbox(8,2)
Goto PREFSEND
End If
If GH=6
PB=Ex Get Part : CP=PB
End If
If GH=7
If CP=0
PTYP$(1)=Ex Filesel$(0,0,"LHA anwählen","","","")
If PTYP$(1)=""
PTYP$(1)=PTP$(1)
End If
End If
If CP=2
PTYP$(2)=Ex Filesel$(0,0,"LZX anwählen","","","")
If PTYP$(2)=""
PTYP$(2)=PTP$(2)
End If
End If
If CP=3
PTYP$(3)=Ex Filesel$(0,0,"UNZIP anwählen","","","")
If PTYP$(3)=""
PTYP$(3)=PTP$(3)
End If
End If
If CP=4
PTYP$(4)=Ex Filesel$(0,0,"DMS anwählen","","","")
If PTYP$(4)=""
PTYP$(4)=PTP$(4)
End If
End If
If CP=5
PTYP$(5)=Ex Filesel$(0,0,"UNARJ anwählen","","","")
If PTYP$(5)=""
PTYP$(5)=PTP$(5)
End If
End If
If CP=6
PTYP$(6)=Ex Filesel$(0,0,"PPACK anwählen","","","")
If PTYP$(6)=""
PTYP$(6)=PTP$(6)
End If
End If
If CP=8
PTYP$(7)=Ex Filesel$(0,0,"UNRAR anwählen","","","")
If PTYP$(7)=""
PTYP$(7)=PTP$(7)
End If
End If
End If
End If
Loop
PREFSEND:
Ex Wind Close 2
Ex Gadgets Close 2
Ex Wind Active 1
Goto SCHLEIFE
'-----------------------------------------------------
Procedure FERTIG
Ex Wind Close 1
Ex Gadgets Close 1
End
End Proc
Procedure FISEL
Shared CP
SUF$=""
If CP=0 Then SUF$="#?.lha"
If CP=1 Then SUF$="#?.lzh"
If CP=2 Then SUF$="#?.lzx"
If CP=3 Then SUF$="#?.zip"
If CP=4 Then SUF$="#?.dms"
If CP=5 Then SUF$="#?.arj"
If CP=7 Then SUF$="#?.run"
If CP=8 Then SUF$="#?.rar"
FILE$=Ex Filesel$(0,0,"Archiv wählen",PA1$,"",SUF$)
End Proc[FILE$]
Procedure PATH[DF$]
PATH$=Ex Devsel$(1,"Zielschublade wählen",DF$)
End Proc[PATH$]
Procedure DEPACK
Shared G$
Open Out 1,"ram:puffer"
Print #1,G$; : Print #1,Chr$(10);
Print #1,"Wait 4 secs"; : Print #1,Chr$(10);
Print #1,"endshell"; : Print #1,Chr$(10);
Close 1
Exec "newshell con:0/0/640/256/Packer-Ausgabe/close/auto from ram:puffer"
End Proc